home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / run123.com / INTR16.PAS next >
Encoding:
Pascal/Delphi Source File  |  1989-03-16  |  9.3 KB  |  222 lines
  1. {══════════════════════════════ INTR16.PAS ═══════════════════════════════}
  2. { ───────────  Turbo 4.0/5.0 subprocess demonstration program  ────────── }
  3. {                 Copyright (c) 1989  Richard W. Prescott                 }
  4. { This Unit contains the assembly code for the basic interrupt routine,   }
  5. { which is installed automatically by the Unit Initialization Code and    }
  6. { is detached automatically by the Unit Exit Code.  The original          }
  7. { interrupt vector is stored in the current Code segment to simplify      }
  8. { chaining to the original interrupt routine.  The assembly code within   }
  9. { the Procedure IHook traps all Interrupt $16 (BIOS Keyboard Services)    }
  10. { requests and issues a FAR Call via the Pointer variable PascalCode.     }
  11. { PascalCode must be initialized to point to an ordinary (not interrupt)  }
  12. { Procedure which will provide the appropriate interrupt service.         }
  13. {═════════════════════════════════════════════════════════════════════════}
  14. { This Unit was compiled and assembled using Turbo Pascal Version 4.0     }
  15. { and TP&Asm Version 2 ß.  TP&Asm provides an integrated compile-time     }
  16. { assembler within the Turbo development environment (and the command     }
  17. { line compiler TPC), resulting in an ASSEMBLY Development Environment    }
  18. { which is identical to your PASCAL Development Environment.              }
  19. {                                                                         }
  20. { TP&Asm Version 2.0 will be available from me for $49 plus $3 P&H.  The  }
  21. { current Beta Test Version 2 ß is available now for $39 plus $3 P&H,     }
  22. { with a free upgrade to 2.0 when it becomes available.                   }
  23. {          Please see the README file for further information.            }
  24. {═════════════════════════════════════════════════════════════════════════}
  25.  
  26. Unit Intr16;
  27.  
  28. interface 
  29.  
  30. {- Public Variables -}
  31.  
  32. TYPE
  33.   UserRegs = RECORD
  34.     CASE INTEGER OF
  35.       0: (Ax,Bx,Cx,Dx,Si,Ds,Di,Es,Bp,Ip,Cs,Flags: WORD);
  36.       1: (Al,Ah,Bl,Bh,Cl,Ch,Dl,Dh : BYTE);
  37.   END; {UserRegs}
  38.  
  39. VAR
  40.   ExitSp,UserSP,UserSS: WORD;
  41.   User: ^UserRegs absolute UserSP;
  42.  
  43. CONST
  44.   PascalCode: Pointer = Nil;
  45.  
  46.  
  47. {- Public Procedure -}
  48.  
  49. PROCEDURE IRestore;
  50.  
  51.  
  52. {- Inline Directives -}
  53.  
  54. {════════════════════════════════ IReturn ════════════════════════════════}
  55. { Clear Carry Flag to signal "Return to Caller", restore Stack Pointer    }
  56. { to its value on entry to the Pascal service routine, and issue a Far    }
  57. { Return.  This technique permits use of IReturn from within nested       }
  58. { sub-procedures.  User registers should be modified before return to     }
  59. { simulate a successful interrupt request.                                }
  60. {════════════════════════════════ IReturn ════════════════════════════════}
  61. PROCEDURE IReturn; {- Inline Directive -}
  62. Assemble
  63.   Clc            ; select Return to Caller
  64.   Mov Sp,ExitSp  ; Restore Stack Pointer
  65.   Retf           ;  .. and return to label "Resume" within IHook
  66. END; {- IReturn -}
  67.  
  68. {════════════════════════════════ IChain ═════════════════════════════════}
  69. { Set Carry Flag to signal "Chain to original Interrupt Vector", restore  }
  70. { Stack Pointer to its value on entry to the Pascal service routine, and  }
  71. { issue a Far Return.  This technique permits use of IChain from within   }
  72. { nested sub-procedures.  User registers should be preserved.             }
  73. {════════════════════════════════ IChain ═════════════════════════════════}
  74. PROCEDURE IChain;  {- Inline Directive -}
  75. Assemble
  76.   Stc            ; select Chain to original Interrupt Vector
  77.   Mov Sp,ExitSp  ; Restore Stack Pointer
  78.   Retf           ;  .. and return to label "Resume" within IHook
  79. END; {- IChain -}
  80.  
  81.  
  82. implementation
  83.  
  84. {════════════════════════════════ CsData ═════════════════════════════════}
  85. { The CSDATA construct is used to store data in the current Code Segment. }
  86. { The original interrupt address Int16Vec must be stored in this Code     }
  87. { Segment to allow Chaining to the original interrupt routine with all of }
  88. { the User Registers intact.  The flag ActiveFlag is stored in the Code   }
  89. { Segment so that it can be inspected before restoring the Turbo DSeg.    }
  90. { CsData Variables are available throughout the current Unit.             }
  91. {════════════════════════════════ CsData ═════════════════════════════════}
  92. CSDATA
  93.   Int16Vec Dd 0
  94.   ActiveFlag Db 0
  95. END; {CsData}
  96.  
  97.  
  98. {═════════════════════════════════ IHook ═════════════════════════════════}
  99. { This is the assembly portion of the interrupt service routine.          }
  100. { First check ActiveFlag (to permit use of the true BIOS Interrupt $16    }
  101. { services within the Pascal Code of our service routine).  If active,    }
  102. { chain to the original interrupt using an indirect jump to the address   }
  103. { Int16Vec stored in this Code Segment.  If not active, save registers,   }
  104. { then restore Ds and issue an indirect call to the address stored in     }
  105. { the Pointer PascalCode.  If PascalCode has not been initialized, ignore }
  106. { the service request and issue a safe "Chain to Original Interrupt".     }
  107. { Within the Pascal service routine, the Calling program registers may    }
  108. { be inspected/modified via the User record, eg "User^.Ax := InChar;"     }
  109. { The Pascal code for the Interrupt Service must end with IReturn/IChain. }
  110. {═════════════════════════════════ IHook ═════════════════════════════════}
  111. PROCEDURE IHook; Forward;
  112. Internal Hook;
  113. ;- Use INTERNAL to eliminate standard Pascal Startup Code
  114.  
  115. CODE Segment
  116.  
  117. IHook PROC NEAR
  118.   Cmp ActiveFlag,FALSE   ; check Flag stored in our CS
  119.   IF NE Jmp Int16Vec     ; (TP&Asm generates an automatic Cs override)
  120.   Inc ActiveFlag         ; Set ActiveFlag := 1 until Resume
  121.  
  122.  WakeUp:
  123. ;- This Push sequence, read in reverse, must match the 
  124. ;- UserRegs record type defined above:
  125.   Push Bp,Es,Di,Ds,Si,Dx,Cx,Bx,Ax  ;- Save User registers
  126.  
  127.   Mov Ax,Seg DATA
  128.   Mov Ds,Ax              ; Restore Our Ds
  129.  
  130.   Cmp W PascalCode+2,0   ; Has the PascalCode been installed?
  131.   Stc
  132.   jE Resume              ; No, then Chain to original interrupt vector
  133.  
  134.   Mov UserSS,Ss          ; Save User Stack Pointer Ss:Sp to permit
  135.   Mov UserSP,Sp          ;  access to User Regs (eg "User^.Ax")
  136.  
  137.   Mov ExitSp,Sp          ; Set Sp value to restore during IChain/IReturn,
  138.   Sub ExitSp,4           ; preserving Return Address of subsequent Far Call
  139.   Call PascalCode        ; Call via Pointer to Pascal Service Routine
  140.  
  141.  Resume:
  142.  
  143. ;- Invoking IChain  will return here with the Carry Flag Set
  144. ;- Invoking IReturn will return here with the Carry Flag Cleared
  145. ;- The following Mov and Pops do not alter flags
  146.  
  147.   Mov ActiveFlag,0       ; Reset Flag stored in our CSeg
  148.   Pop Ax,Bx,Cx,Dx,Si,Ds,Di,Es,Bp   ;- Restore User registers
  149.   jNC Return             ; State of Carry Flag determines whether to ..
  150.  Chain:
  151.   Jmp Int16Vec           ;  .. Chain to the original Interrupt $16 Handler
  152.  Return:
  153.   Iret                   ;  .. or Return directly to caller 
  154.  
  155. IHook ENDP
  156. CODE ENDS
  157. END {- Internal Hook -}
  158.  
  159.  
  160.  
  161. {═════════════════════════════════ IInit ═════════════════════════════════}
  162. { Store the current value of the interrupt $16 vector in the current Code }
  163. { Segment.  Set the new value of the interrupt $16 vector to point to the }
  164. { INTERNAL Procedure IHook.                                               }
  165. {═════════════════════════════════ IInit ═════════════════════════════════}
  166. {- Save and Install New Interrupt 16 -}
  167. PROCEDURE IInit;
  168. {$S-} BEGIN {$S+}   {- Don't generate Stack check code -}
  169.  ASSEMBLE
  170.  
  171. ;- Save & Install new interrupt
  172.   Mov Ax,03516           ; Get Interrupt into Es:Bx
  173.   Int 021                ;  (Stored in Code Seg to allow Chaining)
  174.   Mov W Int16Vec,Bx      ; This Assembly Reference will link in CSDATA
  175.   Mov W Int16Vec+2,Es
  176.  
  177.   Mov Ax,02516           ; Set Interrupt to Ds:Dx
  178.   Push Ds,Cs             ; Save DSeg, 
  179.   Pop Ds                 ;  point Ds to CSeg
  180.   Mov Dx,Offset IHook    ; This Assembly Reference will Link in IHook
  181.   Int 021
  182.   Pop Ds                 ; Restore Ds to DSeg
  183.  
  184.  END; {Assembly}
  185. END; {IInit;}
  186.  
  187.  
  188. {═══════════════════════════════ IRestore ════════════════════════════════}
  189. { Restore the interrupt $16 vector to the value saved during IInit.       }
  190. {═══════════════════════════════ IRestore ════════════════════════════════}
  191. PROCEDURE IRestore; 
  192. {$S-} BEGIN {$S+}   {- Don't generate Stack check code -}
  193.  ASSEMBLE
  194.   Mov Ax,02516           ; Set Interrupt to Ds:Dx
  195.   Push Ds
  196.   Lds Dx,Int16Vec        ; Load Ds:Dx with saved value
  197.   Int 021                ; Restore interrupt vector
  198.   Pop Ds
  199.  END; {Assembly}
  200. END; {IRestore}
  201.  
  202.  
  203. {═════════════════════════════════ IExit ═════════════════════════════════}
  204. { Unit Exit Procedure to automatically detach interrupt system.           }
  205. {═════════════════════════════════ IExit ═════════════════════════════════}
  206. VAR   NextExit: POINTER;
  207. {$F+} PROCEDURE IExit; {$F-}   {- Exit Procedures must use Far Model -}
  208. {$S-} BEGIN {$S+}              {- Don't generate Stack check code -}
  209.  IRestore;
  210.  ExitProc := NextExit;
  211. END; {IExit}
  212.  
  213.  
  214. {═════════════════════════════ Initialiation ═════════════════════════════}
  215. { Automatically install interrupt system.                                 }
  216. {═════════════════════════════ Initialiation ═════════════════════════════}
  217. BEGIN
  218.   IInit;
  219.   NextExit := ExitProc;
  220.   ExitProc := @IExit;       {- Restore Interrupt 16 on Exit -}
  221. END.
  222.